Imports FirebirdSql.Data.FirebirdClient

''' <summary>Firebird open-source database (www.firebirdsql.org)</summary>
''' <remarks>
''' Embedded file version requires embedded firebird engine 2.0 and .net provider FirebirdSql.Data.FirebirdClient.dll (www.sourceforge.net). According to Readme notes:
''' Just copy fbembed.dll, icudt30.dll, icuin30.dll and icuuc30.dll into the directory with your application.
''' Then rename fbembed.dll to either fbclient.dll or gds32.dll depending on your database connectivity software. (note: this doesn't appear to be necessary)
''' Then start your application and it will use the embedded server as a client library and will be able to access
''' local datasases. You should also copy firebird.msg and firebird.conf (if necessary) to the same directory.
''' 
''' In firebird.conf must set ExternalFileAccess = Full
''' 
''' For the client server version, all database files are stored on the root directory or the server with extension .fdb
''' The default administrative login is sysdba/masterkey
''' </remarks>
Public Class clsDBFirebird
    Inherits clsDB

    ''' <summary>
    ''' List of data providers supported by WRDB
    ''' </summary>
    ''' <remarks>Only a subset of these are extensively tested</remarks>
    Public Overrides Property DatabaseType() As enumDBType
        Get
            Return MyBase.DatabaseType
        End Get
        Set(ByVal Value As enumDBType)
            MyBase.DatabaseType = Value
            If DatabaseType = enumDBType.Firebird_Embedded Then
                Dim DLLDir As String = IO.Path.GetDirectoryName(Reflection.Assembly.GetExecutingAssembly.Location)
                Dim EXEDir As String = My.Application.Info.DirectoryPath
                Dim ReqdFiles() As String = {"fbembed.dll", "icudt30.dll", "icuin30.dll", "icuuc30.dll", "firebird.conf", "firebird.msg"}
                'firebird REQUIRES these files to be in the application directory (e.g., WRDBClient or BASINS)--it is not good enough that they be in the same folder as the WRDB.dll file
                'first, make sure they reside in the DLL folder
                Dim AllFound As Boolean = True
                For Each s As String In ReqdFiles
                    If Not My.Computer.FileSystem.FileExists(DLLDir & "\" & s) Then AllFound = False : Exit For
                Next
                If Not AllFound Then
                    Throw New DbSqlException("One or more of the following files which are required for access to Firebird embedded databases were not found in the WRDB installation folder: " & ArrayToCSV(ReqdFiles).Replace(",", ", ") & ". Please manually install these files before attempting to access any tables.")
                End If
                'not, see if the files are in the current application's folder (which may be different); if not found, offer to copy them
                For Each s As String In ReqdFiles
                    If Not My.Computer.FileSystem.FileExists(EXEDir & "\" & s) Then FileCopy(DLLDir & "\" & s, EXEDir & "\" & s)
                Next
            End If
        End Set
    End Property

    ''' <summary>
    ''' Return a copy of the current generic connection
    ''' </summary>
    ''' <returns>Clone of current instance</returns>
    Public Overrides Function Clone() As clsDB
        Dim db As clsDB = New clsDBFirebird
        MyBase.CloneSelf(db)
        Return db
    End Function

    ''' <summary>
    ''' Provider-independent access to CommandBuilder object
    ''' </summary>
    ''' <param name="da">Data adapter</param>
    ''' <returns>CommandBuilder object specific to provider type</returns>
    Public Overrides Function CommandBuilder(ByVal da As DbDataAdapter) As DbCommandBuilder
        Return New FbCommandBuilder(da)
    End Function

    ''' <summary>
    ''' Return a data adapter for the current connection containing data from sql string
    ''' </summary>
    ''' <param name="SqlString">standard sql string</param>
    ''' <returns>Data Adapter</returns>
    Public Overrides Function DataAdapter(ByVal SqlString As String) As DbDataAdapter
        If Connection Is Nothing Then Return Nothing
        Return New FbDataAdapter(SqlString, CType(Connection, FbConnection))
    End Function

    ''' <summary>
    ''' Create a parameter (used to speed up queries and updates); value is initialized to dbnull
    ''' </summary>
    ''' <param name="ParameterName">name of parameter (usually field name)</param>
    ''' <param name="DataType">need to work on this to standarize</param>
    ''' <param name="Size">size if appropriate (strings)</param>
    ''' <returns>Data Parameter</returns>
    Public Overrides Function Parameter(ByRef Command As DbCommand, ByVal ParameterName As String, ByVal DataType As System.Type, Optional ByVal Size As Int16 = 0) As DbParameter
        If Connection Is Nothing Then Return Nothing
        Dim param As FbParameter
        Dim FbType As FbDbType
        If DataType Is GetType(String) Then
            'FbType = IIf(Size > 3, FbDbType.VarChar, FbDbType.Char)
            FbType = FbDbType.VarChar
        ElseIf DataType Is GetType(Date) Then
            FbType = FbDbType.TimeStamp
        ElseIf DataType Is GetType(Double) Then
            FbType = FbDbType.Double
        ElseIf DataType Is GetType(Integer) Then
            FbType = FbDbType.Integer
        ElseIf DataType Is GetType(Boolean) Then
            FbType = FbDbType.Boolean
        ElseIf DataType Is GetType(Short) Then
            FbType = FbDbType.SmallInt
        Else
            Throw New ApplicationException("Invalid type passed to Parameter")
            Return Nothing
        End If
        'If Size > 0 Then
        '    param = New FbParameter(ParameterName, FbType, Size)
        'Else
        '    param = New FbParameter(ParameterName, FbType)
        'End If
        'param.Value = DBNull.Value
        param = CType(Command, FbCommand).CreateParameter
        With param
            .ParameterName = ParameterName
            .FbDbType = FbType
            If Size > 0 Then .Size = Size
            .Value = DBNull.Value
        End With
        Return param
    End Function

    ''' <summary>
    ''' Creates a provider-specific connection object given previously specified properties as required (DataSource, DatabaseName, UserName, Password, etc.)
    ''' Note that the connection is normally automatically created when you instantiate the class
    ''' </summary>
    Public Overrides Sub CreateConnection()
        Try
            Dim csb As New FbConnectionStringBuilder
            With csb
                If DatabaseType = enumDBType.Firebird Then
                    .ServerType = FbServerType.Default
                    .DataSource = DataSource
                    .Database = DatabaseName
                    .UserID = UserName
                    .Password = Password
                Else
                    .ServerType = FbServerType.Embedded
                    .Database = DataSource
                    'note: username/pswd security not available in fb embedded
                End If
                .Dialect = 3
                .ConnectionTimeout = CommandTimeout
                Connection = New FbConnection(.ConnectionString)
            End With
        Catch ex As Exception
            Throw
            Connection = Nothing
        End Try
    End Sub

    ''' <summary>
    ''' Creates new database on the provider (uses supervisor access)
    ''' </summary>
    ''' <param name="DatabaseName">Desired name of new database</param>
    ''' <returns>True if successful</returns>
    Public Overrides Function CreateDatabase(ByRef DatabaseName As String) As Boolean
        Try
            Dim csb As New FbConnectionStringBuilder
            With csb
                If DatabaseType = enumDBType.Firebird Then
                    '.ServerType = FbServerType.Default
                    '.DataSource = DataSource
                    '.Database = DatabaseName
                    Throw New DbSqlException("Firebird does not include a means to perform database creation on a remote server. This function is provided by the database administrator using separate tools such as IBExpert.")
                    Return False
                Else
                    .ServerType = FbServerType.Embedded
                    .Database = DataSource
                End If
                .UserID = UserName
                .Password = Password
                .Dialect = 3
                FbConnection.CreateDatabase(.ConnectionString)
                Return True
            End With
        Catch ex As Exception
            'Throw new DbSqlException
            Return False
        End Try
    End Function

    Private FirebirdBackupFlag As Boolean 'this will be set to true when the firebird backup is complete

    ''' <summary>
    ''' This handler is used to know when the backup and restore operations are done
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub FirebirdBackupDone(ByVal sender As Object, ByVal e As FirebirdSql.Data.Services.ServiceOutputEventArgs)
        FirebirdBackupFlag = True
    End Sub

    ''' <summary>
    ''' Perform database compaction/repair operation where supported
    ''' </summary>
    Public Overrides Sub RepairDatabase(Optional ByVal Interactive As Boolean = False)
        If DatabaseType = enumDBType.Firebird_Embedded Then
            With My.Computer.FileSystem
                Dim NewName As String = DataSource

                'name backup file
                Dim bakfile As String = IO.Path.ChangeExtension(DataSource, ".bak")
                If .FileExists(bakfile) Then .DeleteFile(bakfile)

                Try
                    Dim svcBackup As New FirebirdSql.Data.Services.FbBackup
                    With svcBackup
                        .ConnectionString = Connection.ConnectionString
                        .Options = FirebirdSql.Data.Services.FbBackupFlags.IgnoreLimbo
                        .Verbose = True
                        .BackupFiles.Add(New FirebirdSql.Data.Services.FbBackupFile(bakfile, FileLen(DataSource)))
                        FirebirdBackupFlag = False
                        AddHandler .ServiceOutput, AddressOf FirebirdBackupDone
                        .Execute()

                        Do
                            Threading.Thread.Sleep(100)
                        Loop Until FirebirdBackupFlag

                        RemoveHandler .ServiceOutput, AddressOf FirebirdBackupDone
                    End With

                    Dim svcRestore As New FirebirdSql.Data.Services.FbRestore
                    With svcRestore
                        Dim csb As New FbConnectionStringBuilder(Connection.ConnectionString)
                        csb.Database = NewName
                        .ConnectionString = csb.ConnectionString
                        .Options = FirebirdSql.Data.Services.FbRestoreFlags.Create Or FirebirdSql.Data.Services.FbRestoreFlags.Replace Or FirebirdSql.Data.Services.FbRestoreFlags.DeactivateIndexes
                        .Verbose = True
                        .PageSize = 4096
                        FbConnection.ClearAllPools()
                        .BackupFiles.Add(New FirebirdSql.Data.Services.FbBackupFile(bakfile, FileLen(DataSource)))
                        FirebirdBackupFlag = False
                        AddHandler .ServiceOutput, AddressOf FirebirdBackupDone
                        .Execute()

                        Do
                            Threading.Thread.Sleep(100)
                        Loop Until FirebirdBackupFlag

                        RemoveHandler .ServiceOutput, AddressOf FirebirdBackupDone
                    End With

                    My.Computer.FileSystem.DeleteFile(bakfile)

                Catch ex As Exception
                    Throw New DbSqlException("Unable to compact " & DataSource, ex)
                End Try
            End With
        Else
            MyBase.RepairDatabase(Interactive)
        End If
    End Sub

    'Private Function ArrayToCSV(ByVal ar() As String) As String
    '    Dim csv As String = ""
    '    For Each s As String In ar
    '        csv &= IIf(csv = "", "", ",") & s.Trim
    '    Next
    '    Return csv
    'End Function
End Class

